-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Brig.CanonicalInterpreter where

import Brig.AWS (amazonkaEnv)
import Brig.App as App
import Brig.DeleteQueue.Interpreter as DQ
import Brig.Effects.ConnectionStore (ConnectionStore)
import Brig.Effects.ConnectionStore.Cassandra (connectionStoreToCassandra)
import Brig.Effects.JwtTools
import Brig.Effects.PublicKeyBundle
import Brig.Effects.SFT (SFT, interpretSFT)
import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore)
import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra)
import Brig.IO.Intra (runEvents)
import Brig.Options (federationDomainConfigs, federationStrategy)
import Brig.Options qualified as Opt
import Brig.Team.Template (TeamTemplates)
import Brig.User.Search.Index (IndexEnv (..))
import Cassandra qualified as Cas
import Control.Exception (ErrorCall)
import Control.Lens (to, (^.), _Just)
import Control.Monad.Catch (throwM)
import Data.Coerce (coerce)
import Data.Qualified (Local, toLocalUnsafe)
import Data.ZAuth.CryptoSign (CryptoSign, runCryptoSign)
import Hasql.Pool (UsageError)
import Hasql.Pool qualified as Hasql
import Imports
import Polysemy
import Polysemy.Async
import Polysemy.Conc
import Polysemy.Embed (runEmbedded)
import Polysemy.Error (Error, errorToIOFinal, mapError, runError)
import Polysemy.Input (Input, runInputConst)
import Polysemy.Internal.Kind
import Polysemy.TinyLog (TinyLog)
import Wire.API.Federation.Client qualified
import Wire.API.Federation.Error
import Wire.API.Team.Collaborator
import Wire.ActivationCodeStore (ActivationCodeStore)
import Wire.ActivationCodeStore.Cassandra (interpretActivationCodeStoreToCassandra)
import Wire.AppStore
import Wire.AppStore.Postgres
import Wire.AppSubsystem
import Wire.AppSubsystem.Interpreter
import Wire.AuthenticationSubsystem
import Wire.AuthenticationSubsystem.Config
import Wire.AuthenticationSubsystem.Interpreter
import Wire.BackgroundJobsPublisher (BackgroundJobsPublisher)
import Wire.BackgroundJobsPublisher.RabbitMQ (interpretBackgroundJobsPublisherRabbitMQ)
import Wire.BlockListStore
import Wire.BlockListStore.Cassandra
import Wire.DeleteQueue
import Wire.DomainRegistrationStore
import Wire.DomainRegistrationStore.Cassandra
import Wire.DomainVerificationChallengeStore
import Wire.DomainVerificationChallengeStore.Cassandra
import Wire.EmailSending
import Wire.EmailSending.SES
import Wire.EmailSending.SMTP
import Wire.EmailSubsystem
import Wire.EmailSubsystem.Interpreter
import Wire.EnterpriseLoginSubsystem
import Wire.EnterpriseLoginSubsystem.Error (EnterpriseLoginSubsystemError, enterpriseLoginSubsystemErrorToHttpError)
import Wire.EnterpriseLoginSubsystem.Interpreter
import Wire.EnterpriseLoginSubsystem.Null
import Wire.Error
import Wire.Events
import Wire.FederationAPIAccess qualified
import Wire.FederationAPIAccess.Interpreter (FederationAPIAccessConfig (..), interpretFederationAPIAccess)
import Wire.FederationConfigStore (FederationConfigStore)
import Wire.FederationConfigStore.Cassandra (interpretFederationDomainConfig, remotesMapFromCfgFile)
import Wire.GalleyAPIAccess (GalleyAPIAccess)
import Wire.GalleyAPIAccess.Rpc
import Wire.GundeckAPIAccess
import Wire.HashPassword
import Wire.HashPassword.Interpreter
import Wire.IndexedUserStore
import Wire.IndexedUserStore.ElasticSearch
import Wire.InvitationStore (InvitationStore)
import Wire.InvitationStore.Cassandra (interpretInvitationStoreToCassandra)
import Wire.NotificationSubsystem
import Wire.NotificationSubsystem.Interpreter (defaultNotificationSubsystemConfig, runNotificationSubsystemGundeck)
import Wire.ParseException
import Wire.PasswordResetCodeStore (PasswordResetCodeStore)
import Wire.PasswordResetCodeStore.Cassandra (interpretClientToIO, passwordResetCodeStoreToCassandra)
import Wire.PasswordStore (PasswordStore)
import Wire.PasswordStore.Cassandra (interpretPasswordStore)
import Wire.PropertyStore
import Wire.PropertyStore.Cassandra
import Wire.PropertySubsystem
import Wire.PropertySubsystem.Interpreter
import Wire.RateLimit
import Wire.RateLimit.Interpreter
import Wire.Rpc
import Wire.Sem.Concurrency
import Wire.Sem.Concurrency.IO
import Wire.Sem.Delay
import Wire.Sem.Jwk
import Wire.Sem.Logger.TinyLog (loggerToTinyLogReqId)
import Wire.Sem.Metrics
import Wire.Sem.Metrics.IO (runMetricsToIO)
import Wire.Sem.Now (Now)
import Wire.Sem.Now.IO (nowToIOAction)
import Wire.Sem.Paging.Cassandra (InternalPaging)
import Wire.Sem.Random
import Wire.Sem.Random.IO
import Wire.SessionStore
import Wire.SessionStore.Cassandra (interpretSessionStoreCassandra)
import Wire.SparAPIAccess (SparAPIAccess)
import Wire.SparAPIAccess.Rpc
import Wire.TeamCollaboratorsStore
import Wire.TeamCollaboratorsStore.Postgres
import Wire.TeamCollaboratorsSubsystem
import Wire.TeamCollaboratorsSubsystem.Interpreter
import Wire.TeamInvitationSubsystem
import Wire.TeamInvitationSubsystem.Error
import Wire.TeamInvitationSubsystem.Interpreter
import Wire.TeamSubsystem
import Wire.TeamSubsystem.GalleyAPI
import Wire.UserGroupStore
import Wire.UserGroupStore.Postgres (interpretUserGroupStoreToPostgres)
import Wire.UserGroupSubsystem
import Wire.UserGroupSubsystem.Interpreter
import Wire.UserKeyStore
import Wire.UserKeyStore.Cassandra
import Wire.UserStore
import Wire.UserStore.Cassandra
import Wire.UserSubsystem
import Wire.UserSubsystem.Error
import Wire.UserSubsystem.Interpreter
import Wire.VerificationCodeStore
import Wire.VerificationCodeStore.Cassandra
import Wire.VerificationCodeSubsystem
import Wire.VerificationCodeSubsystem.Interpreter

type BrigCanonicalEffects =
  '[ AppSubsystem,
     AuthenticationSubsystem,
     TeamInvitationSubsystem,
     EnterpriseLoginSubsystem,
     UserGroupSubsystem,
     UserSubsystem,
     TeamCollaboratorsSubsystem
   ]
    `Append` BrigLowerLevelEffects

-- | These effects have interpreters which don't depend on each other
type BrigLowerLevelEffects =
  '[ TeamSubsystem,
     TeamCollaboratorsStore,
     AppStore,
     EmailSubsystem,
     VerificationCodeSubsystem,
     PropertySubsystem,
     DeleteQueue,
     Wire.Events.Events,
     NotificationSubsystem,
     BackgroundJobsPublisher,
     RateLimit,
     UserGroupStore,
     Error AppSubsystemError,
     Error TeamCollaboratorsError,
     Error UsageError,
     Error EnterpriseLoginSubsystemError,
     Error UserSubsystemError,
     Error UserGroupSubsystemError,
     Error TeamInvitationSubsystemError,
     Error AuthenticationSubsystemError,
     Error Wire.API.Federation.Error.FederationError,
     Error VerificationCodeSubsystemError,
     Error PropertySubsystemError,
     Error RateLimitExceeded,
     Error HttpError,
     Wire.FederationAPIAccess.FederationAPIAccess Wire.API.Federation.Client.FederatorClient,
     DomainVerificationChallengeStore,
     DomainRegistrationStore,
     CryptoSign,
     HashPassword,
     UserKeyStore,
     UserStore,
     IndexedUserStore,
     SessionStore,
     PasswordStore,
     VerificationCodeStore,
     ActivationCodeStore,
     InvitationStore,
     PropertyStore,
     SFT,
     ConnectionStore InternalPaging,
     Input Hasql.Pool,
     Input AppSubsystemConfig,
     Input UserSubsystemConfig,
     Input VerificationCodeThrottleTTL,
     Input (Local ()),
     Input (AuthenticationSubsystemConfig),
     Input TeamTemplates,
     GundeckAPIAccess,
     FederationConfigStore,
     Jwk,
     PublicKeyBundle,
     JwtTools,
     BlockListStore,
     UserPendingActivationStore InternalPaging,
     Now,
     Delay,
     Random,
     PasswordResetCodeStore,
     GalleyAPIAccess,
     SparAPIAccess,
     EmailSending,
     Rpc,
     Metrics,
     Embed Cas.Client,
     Error ParseException,
     Error ErrorCall,
     Error SomeException,
     TinyLog,
     Embed HttpClientIO,
     Embed IO,
     Race,
     Async,
     Concurrency 'Unsafe,
     Final IO
   ]

runBrigToIO :: App.Env -> AppT BrigCanonicalEffects a -> IO a
runBrigToIO e (AppT ma) = do
  let blockedDomains =
        e
          ^. ( App.settingsLens
                 . Opt.customerExtensionsLens
                 . _Just
                 . to
                   ( coerce {- safely drop newtype wrapper -}
                       Opt.domainsBlockedForRegistration
                   )
             )
      userSubsystemConfig =
        UserSubsystemConfig
          { emailVisibilityConfig = e.settings.emailVisibility,
            defaultLocale = Opt.defaultUserLocale e.settings,
            searchSameTeamOnly = fromMaybe False e.settings.searchSameTeamOnly,
            maxTeamSize = e.settings.maxTeamSize,
            activationCodeTimeout = e.settings.activationTimeout,
            blockedDomains = blockedDomains
          }
      appSubsystemConfig = AppSubsystemConfig {defaultLocale = userSubsystemConfig.defaultLocale}
      teamInvitationSubsystemConfig =
        TeamInvitationSubsystemConfig
          { maxTeamSize = e.settings.maxTeamSize,
            teamInvitationTimeout = e.settings.teamInvitationTimeout,
            blockedDomains = blockedDomains
          }
      federationApiAccessConfig =
        FederationAPIAccessConfig
          { ownDomain = e.settings.federationDomain,
            federatorEndpoint = e.federator,
            http2Manager = e.http2Manager,
            requestId = e.requestId
          }
      propertySubsystemConfig =
        PropertySubsystemConfig
          { maxKeyLength = fromMaybe Opt.defMaxKeyLen e.settings.propertyMaxKeyLen,
            maxValueLength = fromMaybe Opt.defMaxValueLen e.settings.propertyMaxValueLen,
            maxProperties = 16
          }
      localUnit = toLocalUnsafe e.settings.federationDomain ()
      authenticationSubsystemConfig =
        AuthenticationSubsystemConfig
          { zauthEnv = e.zauthEnv,
            allowlistEmailDomains = e.settings.allowlistEmailDomains,
            local = localUnit,
            userCookieRenewAge = e.settings.userCookieRenewAge,
            userCookieLimit = e.settings.userCookieLimit,
            userCookieThrottle = e.settings.userCookieThrottle
          }
      mainESEnv = e.indexEnv ^. to idxElastic
      indexedUserStoreConfig =
        IndexedUserStoreConfig
          { conn =
              ESConn
                { env = mainESEnv,
                  indexName = e.indexEnv ^. to idxName
                },
            additionalConn =
              (e.indexEnv ^. to idxAdditionalName) <&> \additionalIndexName ->
                ESConn
                  { env = e.indexEnv ^. to idxAdditionalElastic . to (fromMaybe mainESEnv),
                    indexName = additionalIndexName
                  }
          }

      -- These interpreters depend on each other, we use let recursion to solve that.
      --
      -- This terminates if and only if we do not create an action sequence at
      -- runtime such that interpretation of actions results in a call cycle.
      userSubsystemInterpreter :: (Members BrigLowerLevelEffects r) => InterpreterFor UserSubsystem r
      userSubsystemInterpreter = runUserSubsystem authSubsystemInterpreter

      authSubsystemInterpreter :: (Members BrigLowerLevelEffects r) => InterpreterFor AuthenticationSubsystem r
      authSubsystemInterpreter = interpretAuthenticationSubsystem userSubsystemInterpreter

  ( either throwM pure
      <=< ( runFinal
              . unsafelyPerformConcurrency
              . asyncToIOFinal
              . interpretRace
              . embedToFinal
              . runEmbedded (runHttpClientIO e)
              . loggerToTinyLogReqId e.requestId e.appLogger
              . runError @SomeException
              . mapError @ErrorCall SomeException
              . mapError @ParseException SomeException
              . interpretClientToIO e.casClient
              . runMetricsToIO
              . runRpcWithHttp e.httpManager e.requestId
              . emailSendingInterpreter e
              . interpretSparAPIAccessToRpc e.sparEndpoint
              . interpretGalleyAPIAccessToRpc e.disabledVersions e.galleyEndpoint
              . passwordResetCodeStoreToCassandra @Cas.Client
              . randomToIO
              . runDelay
              . nowToIOAction e.currentTime
              . userPendingActivationStoreToCassandra
              . interpretBlockListStoreToCassandra e.casClient
              . interpretJwtTools
              . interpretPublicKeyBundle
              . interpretJwk
              . interpretFederationDomainConfig e.casClient e.settings.federationStrategy (foldMap (remotesMapFromCfgFile . fmap (.federationDomainConfig)) e.settings.federationDomainConfigs)
              . runGundeckAPIAccess e.gundeckEndpoint
              . runInputConst (teamTemplatesNoLocale e)
              . runInputConst authenticationSubsystemConfig
              . runInputConst localUnit
              . runInputConst (fromIntegral $ Opt.twoFACodeGenerationDelaySecs e.settings)
              . runInputConst userSubsystemConfig
              . runInputConst appSubsystemConfig
              . runInputConst e.hasqlPool
              . connectionStoreToCassandra
              . interpretSFT e.httpManager
              . interpretPropertyStoreCassandra e.casClient
              . interpretInvitationStoreToCassandra e.casClient
              . interpretActivationCodeStoreToCassandra e.casClient
              . interpretVerificationCodeStoreCassandra e.casClient
              . interpretPasswordStore e.casClient
              . interpretSessionStoreCassandra e.casClient
              . interpretIndexedUserStoreES indexedUserStoreConfig
              . interpretUserStoreCassandra e.casClient
              . interpretUserKeyStoreCassandra e.casClient
              . runHashPassword e.settings.passwordHashingOptions
              . runCryptoSign
              . interpretDomainRegistrationStoreToCassandra e.casClient
              . interpretDomainVerificationChallengeStoreToCassandra e.casClient e.settings.challengeTTL
              . interpretFederationAPIAccess federationApiAccessConfig
              . rethrowHttpErrorIO
              . mapError rateLimitExceededToHttpError
              . mapError propertySubsystemErrorToHttpError
              . mapError verificationCodeSubsystemErrorToHttpError
              . mapError (StdError . federationErrorToWai)
              . mapError authenticationSubsystemErrorToHttpError
              . mapError teamInvitationErrorToHttpError
              . mapError userGroupSubsystemErrorToHttpError
              . mapError userSubsystemErrorToHttpError
              . mapError enterpriseLoginSubsystemErrorToHttpError
              . mapError postgresUsageErrorToHttpError
              . mapError teamCollaboratorsSubsystemErrorToHttpError
              . mapError appSubsystemErrorToHttpError
              . interpretUserGroupStoreToPostgres
              . interpretRateLimit e.rateLimitEnv
              . interpretBackgroundJobsPublisherRabbitMQ e.requestId e.amqpJobsPublisherChannel
              . runNotificationSubsystemGundeck (defaultNotificationSubsystemConfig e.requestId)
              . runEvents
              . runDeleteQueue e.internalEvents
              . interpretPropertySubsystem propertySubsystemConfig
              . interpretVerificationCodeSubsystem
              . emailSubsystemInterpreter e.userTemplates e.teamTemplates e.templateBranding
              . interpretAppStoreToPostgres
              . interpretTeamCollaboratorsStoreToPostgres
              . interpretTeamSubsystemToGalleyAPI
              . interpretTeamCollaboratorsSubsystem
              . userSubsystemInterpreter
              . interpretUserGroupSubsystem
              . maybe
                runEnterpriseLoginSubsystemNoConfig
                runEnterpriseLoginSubsystemWithConfig
                (mkEnterpriseLoginSubsystemConfig e)
              . runTeamInvitationSubsystem teamInvitationSubsystemConfig
              . authSubsystemInterpreter
              . runAppSubsystem
          )
    )
    $ runReaderT ma e

mkEnterpriseLoginSubsystemEmailConfig :: Env -> Maybe EnterpriseLoginSubsystemEmailConfig
mkEnterpriseLoginSubsystemEmailConfig env = do
  recipient <- env.settings.auditLogEmailRecipient
  let sender = env.emailSender
  pure
    EnterpriseLoginSubsystemEmailConfig
      { auditEmailSender = sender,
        auditEmailRecipient = recipient
      }

mkEnterpriseLoginSubsystemConfig :: Env -> Maybe EnterpriseLoginSubsystemConfig
mkEnterpriseLoginSubsystemConfig env = do
  endpoint <- env.wireServerEnterpriseEndpoint
  pure
    EnterpriseLoginSubsystemConfig
      { emailConfig = mkEnterpriseLoginSubsystemEmailConfig env,
        wireServerEnterpriseEndpoint = endpoint
      }

rethrowHttpErrorIO :: (Member (Final IO) r) => InterpreterFor (Error HttpError) r
rethrowHttpErrorIO act = do
  eithError <- errorToIOFinal act
  case eithError of
    Left err -> embedToFinal $ throwM $ err
    Right a -> pure a

emailSendingInterpreter :: (Member (Embed IO) r) => Env -> InterpreterFor EmailSending r
emailSendingInterpreter e = do
  case e.smtpEnv of
    Just smtp -> emailViaSMTPInterpreter e.appLogger smtp
    Nothing -> emailViaSESInterpreter (e.awsEnv ^. amazonkaEnv)
